home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
quintus
/
quintus0.lha
/
work
/
library_2.06.2
< prev
next >
Wrap
Text File
|
1992-04-03
|
23KB
|
905 lines
%%% LIBRARY SECTION
%%% version 2.00.0 (based on library_16.3)
%%% added identical_delete_all
%%% added identical_delete_all_duplicates
%%% version 2.00.1
%%% added var_eq_member
%%% added var_eq
%%% version 2.00.5
%%% added list_vars
%%% version 2.00.9
%%% added count_occurrences
%%% fixed bug in var_eq
%%% moved ground from rewrite to library
%%% moved unground from rewrite to library
%%% added increment_counter
%%% added set_counter
%%% optimized var_eq
%%% version 2.01.9
%%% optimized term rewriting
%%% version 2.04.0
%%% logically erased nuclei while hyper-linking
%%% version 2.04.3
%%% added reverse/2
%%% version 2.04.6
%%% added min_list
%%% added get_list
%%% version 2.04.8
%%% added get_subterms
%%% version 2.05.1
%%% added gensym
%%% added common_variables
%%% version 2.05.3
%%% moved numbervars to als
%%% replaced integer_name with name
%%% version 2.05.8
%%% removed append/3
%%% version 2.06.0
%%% added is_subterm/2
%%% added identical_subset/2
%%% added identical_set_difference/3
%%% added substitute_term/4
%%% added identical_embedded/2
%%% added identical_set/2
%%% made delete_all/3 and identical_delete_all/3 deterministic
%%% added replace_list/4
%%% or_list/2
%%% version 2.06.1
%%% added substitute_term_all/4
%%% added permutations/2
%%% added append_lists/2
%%% added tail/2
%%% added retract_all/1
%%% version 2.06.2
%%% added ground_like/4
%%% added term_size_structure/2
%%% added enumerate/4
%%%
%%% LINEARIZATION
%%%
%%% linearize_term creates a linearized version of a term i.e.
%%% linearize_term(p(X,X),p(X,V),[X],[V])
%%% call at top level by linearize_term(Term,X,Y,Z).
%%% To make possible fast unification
%%% using Prolog's built in unification without occurs check.
linearize_term(Term, Term, [], []) :-
numbervars(Term,0,0), !.
linearize_term(Term, Newterm, Vars1, Vars2) :-
linearize(Term, Newterm, [], [], Oldvars, Newvars),
pairs(Oldvars, Newvars, Vars1, Vars2, Vars3), !.
%%% Makes use of predicate linearize, with arguments as follows:
%%% linearize(Input_term, Linearized_version, Previous_oldvars,
%%% Previous_linearized_vars, New_oldvars, New_linearized_vars)
%%% so linearize(p(X,X),p(U,V),[],[],[X,X],[U,V])
%%% call at top level by linearize(Input_term, Y, [], [], U, V).
%%% generate a new variable S after the first time a
%%% variable is seen.
linearize(R,S,O1,O2,[R|O1],[S|O2]) :-
var(R), identical_member(R,O1), !.
%%% don't generate a new variable S.
linearize(R,R,O1,O2,[R|O1],[R|O2]) :- var(R), !.
linearize(R,S,Old1,Old2,New1,New2) :-
R =.. [F|Rlist],
linearize2(Rlist,Slist,Old1,Old2,New1,New2),
S =.. [F|Slist].
linearize2([],[],Old1,Old2,Old1,Old2) :- !.
linearize2([R|Rlist],[S|Slist],Old1,Old2,New1,New2) :-
linearize(R,S,Old1,Old2,Mid1,Mid2),!,
linearize2(Rlist,Slist,Mid1,Mid2,New1,New2).
%%% pairs takes two lists and finds matching variables. For
%%% example, pairs([X,X,Y],[X1,X2,X3],[X1],[X2],[X]). This
%%% makes use of the lists returned by linearize.
pairs([X|L1],[Y|L2],[Y|Z1],[W|Z2],V) :-
identical_member(X,L1), !,
firstmatch(X,L1,L2,W),
pairs(L1,L2,Z1,Z2,Z3),
remove_duplicates([X|Z3],V).
pairs([X|L1],[Y|L2],Z1,Z2,Z3) :-
pairs(L1,L2,Z1,Z2,Z3).
pairs([],[],[],[],[]).
firstmatch(X,[Y|L1],[Z|L2],Z) :-
X==Y,!.
firstmatch(X,[Y|L1],[Z|L2],W) :-
firstmatch(X,L1,L2,W).
%%% rename a variable if an identical one exists.
remove_duplicates([X|Y],[U|Y]) :-
identical_member(X,Y), !.
remove_duplicates(X,X).
%%% unify two lists.
unify_lists([], []) :- !.
unify_lists([X|XRest], [Y|YRest]) :-
unify(X, Y), !,
unify_lists(XRest, YRest).
%%% Occurs check.
occurs_check(Term, Var) :-
var(Term), !, Term \== Var.
occurs_check(Term, Var) :-
functor(Term, _, Arity),
occurs_check(Arity, Term, Var).
occurs_check(0, _, _) :- !.
occurs_check(N, Term, Var) :-
arg(N, Term, Arg),
occurs_check(Arg, Var),
M is N-1, !,
occurs_check(M, Term, Var).
%%% unify with occurs check.
unify(X,Y) :- X == Y, !.
unify(X,Y) :- unify1(X,Y), !.
unify1(X, Y) :-
var(X), var(Y), !, X = Y.
unify1(X, Y) :-
var(X), !, occurs_check(Y, X), X = Y.
unify1(X, Y) :-
var(Y), !, occurs_check(X, Y), Y = X.
unify1(X, Y) :-
atomic(X), !, X = Y.
unify1(X, Y) :-
functor(X, F, N), functor(Y, F, N),
unify1(N, X, Y).
unify1(0, X, Y) :- !.
unify1(N, X, Y) :-
arg(N, X, Xn), arg(N, Y, Yn),
unify(Xn, Yn),
M is N-1, !,
unify1(M, X, Y).
%%% separate Nth element and the rest from a list.
retrieve_N(L,NN,X,Rest) :-
retrieve_N(L,1,NN,X,Rest), !.
retrieve_N([L|Ls],N1,N2,X,[L|Rs]) :-
N1 < N2,
NN is N1 + 1,
!,
retrieve_N(Ls,NN,N2,X,Rs).
retrieve_N([L|Ls],N,N,L,Ls).
%%% separate Nth element and the rest from two lists.
retrieve_N2(L1,L2,NN,X,Xs,Y,Ys) :-
retrieve_N2(L1,L2,1,NN,X,Xs,Y,Ys), !.
retrieve_N2([L1|Ls1],[L2|Ls2],N1,N2,X,[L1|Xs],Y,[L2|Ys]) :-
N1 < N2,
NN is N1 + 1,
!,
retrieve_N2(Ls1,Ls2,NN,N2,X,Xs,Y,Ys).
retrieve_N2([L1|Ls1],[L2|Ls2],N,N,L1,Ls1,L2,Ls2).
%%% find a member.
member(X,[X|_]).
member(X,[_|Ys]) :- member(X,Ys).
%%% find an identical member.
identical_member(X,[Y|Z]) :- X == Y,!.
identical_member(X,[Y|Z]) :- identical_member(X,Z).
%%% find a member and the rest.
member_N([X|Xs],X,Xs).
member_N([X|Xs],Y,[X|Zs]) :-
member_N(Xs,Y,Zs).
%%% reverse a list.
reverse(X,Y) :- reverse(X,[],Y).
reverse([],X,X) :- !.
reverse([X|Xs],Y,Z) :- reverse(Xs,[X|Y],Z).
%%% delete all the occurrences in a list.
delete_all(_,[],[]) :- !.
delete_all(X,[X|Ys],Z) :-
!,
delete_all(X,Ys,Z).
delete_all(X,[Y|Ys],[Y|Z]) :-
delete_all(X,Ys,Z).
%%% delete all the identical occurrences in a list.
identical_delete_all(_,[],[]) :- !.
identical_delete_all(X,[Y|Ys],Z) :-
X==Y,
!,
identical_delete_all(X,Ys,Z).
identical_delete_all(X,[Y|Ys],[Y|Z]) :-
identical_delete_all(X,Ys,Z).
%%% merge with duplicate deletion.
merge([X|Xs],Y,Z) :-
member(X,Y),
!,
merge(Xs,Y,Z).
merge([X|Xs],Y,[X|Zs]) :-
!,
merge(Xs,Y,Zs).
merge([],Z,Z).
%%% merge of two ordered lists with duplicate deletion.
ordered_merge([X|XR],[X|YR],[X|Z]) :-
!,
ordered_merge(XR,YR,Z).
ordered_merge([X|XR],[Y|YR],[X|Z]) :-
X < Y,
!,
ordered_merge(XR,[Y|YR],Z).
ordered_merge([X|XR],[Y|YR],[Y|Z]) :-
!,
ordered_merge([X|XR],YR,Z).
ordered_merge([],Y,Y) :- !.
ordered_merge(X,[],X).
%%% get the minumum of two values.
minimum(X,Y,Y) :- Y =< X, !. % red cut.
minimum(X,Y,X).
%%% get the maximum of two values.
maximum(X,Y,Y) :- Y >= X, !. % red cut.
maximum(X,Y,X).
%%% calculate the size of a term.
%%% constants: counted as 1.
%%% varaibles: counted as 1.
%%% functiors: counted as 1 plus the size of all its arguments.
%%% predicates: counted as 1 plus the size of all its arguments.
term_size(Term,Size) :-
term_size(Term,0,Size), !.
term_size(Term,Size1,Size2) :-
atomic(Term), !, Size2 is Size1 + 1.
term_size(Term,Size1,Size2) :-
var(Term), !, Size2 is Size1 + 1.
term_size(Term,Size1,Size2) :-
functor(Term,F,N),
SizeM is Size1 + 1,
args_size(Term,0,N,SizeM,Size2).
args_size(Term,N1,N2,SizeI,SizeO) :-
NN is N1 + 1,
NN =< N2,
arg(NN,Term,Arg),
term_size(Arg,SizeI,SizeM),
!,
args_size(Term,NN,N2,SizeM,SizeO).
args_size(Term,N,N,SizeO,SizeO).
%%% term_depth is to calculate the number of nesting levels of a term.
%%% constants: counted as 0.
%%% variables: counted as 0.
%%% functors: counted as 1 plus the maximum depth of its arguments.
%%% predicates: counted as 1 plus the maximum depth of its arguments.
term_depth(X,0) :- var(X), !.
term_depth(X,0) :- atomic(X), !.
term_depth(X,D) :-
X =.. [F|Args],
arg_depth(Args,0,Darg),
D is Darg + 1, !.
arg_depth([A1|As],Din,Dout) :-
term_depth(A1,D1),
maximum(Din,D1,D2), !,
arg_depth(As,D2,Dout).
arg_depth([],D,D).
%%% Find the biggest number in a list.
%%% max_list fails if the list is empty.
max_list([P|Ps],M) :- max_list(Ps,P,M), !.
max_list([P2|Ps],P1,M) :-
P2 > P1, !,
max_list(Ps,P2,M).
max_list([_|Ps],P1,M) :-
!, max_list(Ps,P1,M).
max_list([],M,M).
%%% Find the smallest number in a list.
%%% min_list fails if the list is empty.
min_list([P|Ps],M) :- min_list(Ps,P,M), !.
min_list([P2|Ps],P1,M) :-
P2 < P1, !,
min_list(Ps,P2,M).
min_list([_|Ps],P1,M) :-
!, min_list(Ps,P1,M).
min_list([],M,M).
%%% Compute distinct variable list of a term with a left-over dummy variable.
%%% The left-over dummy variable is used to unify with unequally long
%%% conatant list.
%%% For example, the list for g(X,f(a,Y)) is [X,Y|Z].
vars_tail(Term,Vars) :-
vars_tail(Term,[],_,Vars,Hole), !.
vars_tail(Term, Sofar_in, Sofar_in,Hole,Hole) :- atomic(Term), !.
vars_tail(Term, Sofar_in, Sofar_in,Hole,Hole) :- var(Term),
identical_member(Term, Sofar_in), !.
vars_tail(Term, Sofar_in, [Term|Sofar_in],[Term|Hole],Hole) :-
var(Term), !.
vars_tail(Term, Sofar_in,Sofar_out,Vars,Hole) :-
functor(Term, _, N),
vars_tail(0,N,Term,Sofar_in,Sofar_out,Vars,Hole).
vars_tail(N,N,_,S,S,Hole,Hole) :- !.
vars_tail(N1,N2,Term,Sofar_in,Sofar_out,Vars,Hole) :-
M is N1+1,
arg(M,Term,Arg),
vars_tail(Arg,Sofar_in,Sofar_mid,Vars,Hole1),
!,
vars_tail(M,N2,Term,Sofar_mid,Sofar_out,Hole1,Hole).
%%% copy a term without using assert and retract.
new_copy(R,S) :- new_copy(R,S,[],O).
new_copy(R,R,O1,O1) :-
atomic(R), !.
new_copy(R,S,O1,O1) :-
var(R), memcopy(R,O1,S), !.
new_copy(R,S,O1,[vp(R,S)|O1]) :-
var(R), !.
new_copy(R,S,O1,O2) :-
R =.. [F|Rlist],
new_copy2(Rlist,Slist,O1,O2),
S =.. [F|Slist].
new_copy2([],[],O1,O1) :- !.
new_copy2([R|Rlist],[S|Slist],O1,O2) :-
new_copy(R,S,O1,M1), !,
new_copy2(Rlist,Slist,M1,O2).
memcopy(R,[vp(S,T)|_],T) :- R == S, !.
memcopy(R,[_|Ys],T) :- memcopy(R,Ys,T).
%%% remove ``not'' if there, add if not.
negate(not(X),X) :- !.
negate(X,not(X)).
%%% return [] if bagof fails.
bagof1(X,G,C) :-
bagof(X,G,C), !.
bagof1(_,_,[]).
%%% check if a term is a list.
is_list([_|_]) :- !.
is_list([]).
%%% remove all duplicates in a list.
delete_all_duplicates([X|Xs],[X|Ys]) :-
delete_all(X,Xs,Z),
!,
delete_all_duplicates(Z,Ys).
delete_all_duplicates([],[]).
%%% remove all identical duplicates in a list.
identical_delete_all_duplicates([X|Xs],[X|Ys]) :-
identical_delete_all(X,Xs,Z),
!,
identical_delete_all_duplicates(Z,Ys).
identical_delete_all_duplicates([],[]).
%%% Make an ordinal list for a list. If a list has N members, then the
%%% ordinal list is [1,...,N].
corresp_ordinals_list(List,OrdList) :-
corresp_ordinals_list(List,1,OrdList), !.
corresp_ordinals_list([_|Ls],N1,[N1|Os]) :-
N2 is N1 + 1, !,
corresp_ordinals_list(Ls,N2,Os).
corresp_ordinals_list([],_,[]).
%%% The list contains of |C| L2's, and one L1's at Nth position.
list_one_N(C,L2,N,L1,List) :-
list_one_N(C,L2,1,N,L1,List), !.
list_one_N([_|Lits],L2,N2,N2,L1,[L1|List]) :-
NN is N2 + 1,
!, list_one_N(Lits,L2,NN,N2,L1,List).
list_one_N([_|Lits],L2,N1,N2,L1,[L2|List]) :-
NN is N1 + 1,
!, list_one_N(Lits,L2,NN,N2,L1,List).
list_one_N([],_,_,_,_,[]).
%%% The output contains of |C| binary numbers, and the content in positions
%%% specified by the list L are N2, the others are N1.
list_multi_Ns(C,N1,L,N2,List) :-
list_multi_Ns(C,N1,1,L,N2,List), !.
list_multi_Ns([_|Lits],N1,N,[N|L],N2,[N2|List]) :-
NN is N + 1,
!, list_multi_Ns(Lits,N1,NN,L,N2,List).
list_multi_Ns([_|Lits],N1,N,L,N2,[N1|List]) :-
NN is N + 1,
!, list_multi_Ns(Lits,N1,NN,L,N2,List).
list_multi_Ns([],_,_,_,_,[]).
%%% The list contains of |C| L2's.
list_of_Ns([_|Lits],L2,[L2|List]) :-
!, list_of_Ns(Lits,L2,List).
list_of_Ns([],_,[]).
%%% A list of natural numbers from 1 to N.
list_of_natural_numbers_up_to_N(N,Un) :-
list_of_natural_numbers_up_to_N(1,N,Un), !.
list_of_natural_numbers_up_to_N(N1,N2,[N1|Un]) :-
N1 < N2,
NN is N1 + 1, !,
list_of_natural_numbers_up_to_N(NN,N2,Un).
list_of_natural_numbers_up_to_N(N1,N1,[N1]) :- !.
list_of_natural_numbers_up_to_N(_,_,[]).
%%% Succeeds if the input ground clause is a tautology.
tautology_clause(C) :-
append(_,[X|T],C),
negate(X,Y),
member(Y,T), !.
%%% Succeeds if the input first-order clause is a tautology.
fol_tautology_clause(C) :-
append(_,[X|T],C),
negate(X,Y),
identical_member(Y,T), !.
%%% return 1 if unit, otherwise 0.
decide_unit([_],1) :- !.
decide_unit(_,0) :- !.
%%% Assert X once.
assert_once(X) :-
X, !.
assert_once(X) :-
assert(X), !.
%%% Negate all literals in a clause.
negate_clause([D1|Ds1],[D2|Ds2]) :-
negate(D1,D2),
!, negate_clause(Ds1,Ds2).
negate_clause([],[]).
%%% List_vars generates a list of variables in a term.
list_vars(T,Vs) :-
list_vars_1(T,[],Vs1),
identical_delete_all_duplicates(Vs1,Vs),
!.
list_vars_1(T,Vs,[T|Vs]) :-
var(T),
!.
list_vars_1(T,Vs1,Vs2) :-
functor(T,_,N),
list_vars_2(T,Vs1,Vs2,N).
list_vars_2(_,Vs,Vs,0).
list_vars_2(T,Vs1,Vs2,N) :-
arg(N,T,A),
list_vars_1(A,Vs1,Vs3),
N1 is N-1,
!,
list_vars_2(T,Vs3,Vs2,N1).
%%% Count_occurrences counts the number of times one term occurs in another.
count_occurrences(T1,T2,N) :- count_occurrences_1(T1,T2,0,N).
count_occurrences_1(T1,T2,N1,N2) :-
T1==T2,
!,
N2 is N1+1.
count_occurrences_1(T1,T2,N1,N2) :-
nonvar(T2),
!,
functor(T2,_,A),
count_occurrences_2(T1,T2,N1,N2,A).
count_occurrences_1(_,_,N,N).
count_occurrences_2(_,_,N,N,0).
count_occurrences_2(T1,T2,N1,N2,A) :-
arg(A,T2,T3),
count_occurrences_1(T1,T3,N1,N3),
A1 is A-1,
!,
count_occurrences_2(T1,T2,N3,N2,A1).
%%% Ground grounds a term. Ground also returns a list of the variables in the
%%% term and a list of the constants used to ground the term.
ground(T1,T2,Vs,Cs) :-
vars_tail(T1,Vs),
const_list(Cs),
not(not(ground1(T1,Vs))),
retract(grnd(T2)),
!.
ground1(T,Vs) :-
const_list(Vs),
asserta(grnd(T)),
!.
%%% Ground_like grounds a term using a specified list of variables and
%%% constants.
ground_like(T1,T2,Vs,Cs) :-
not(not(ground_like1(T1,Vs,Cs))),
retract(grnd_like(T2)),
!.
ground_like1(T,Vs,Vs) :-
asserta(grnd_like(T)),
!.
%%% Unground ungrounds a grounded term.
unground(T,T,Vs,_) :-
var(Vs),
!.
unground(T1,T2,Vs,Cs) :-
atom(T1),
!,
unground1(T1,T2,Vs,Cs).
unground(T1,T2,Vs,Cs) :-
functor(T1,F,N),
unground2(T1,As,Vs,Cs,N,1),
T2=..[F|As].
unground1(T,T,Vs,_) :-
var(Vs),
!.
unground1(C,V,[V|_],[C|_]) :- !.
unground1(T1,T2,[_|Vs],[_|Cs]) :-
!,
unground1(T1,T2,Vs,Cs).
unground2(_,[],_,_,N,M) :-
M>N,
!.
unground2(T,[A|As],Vs,Cs,N,M) :-
arg(M,T,A1),
unground(A1,A,Vs,Cs),
M1 is M+1,
!,
unground2(T,As,Vs,Cs,N,M1).
%%% Increment increments a counter.
increment_counter(C,N) :-
retract(counter(C,N1)),
N2 is N1+N,
assert(counter(C,N2)),
!.
%%% Set_counter sets a counter.
set_counter(C,N) :-
retract(counter(C,_)),
!,
assert(counter(C,N)),
!.
set_counter(C,N) :-
assert(counter(C,N)),
!.
%%% Logically erase a clause.
logically_erase(Proc,Ref) :-
assertz(logically_erased(Proc,Ref)).
%%% Physically erase the logically erased clauses of a procedure.
physically_erase(Proc) :-
retract(logically_erased(Proc,Ref)),
erase(Ref),
fail.
physically_erase(_).
%%% Obtain the Nth element of a list.
get_list(Xs,N,X) :- get_list(Xs,N,X,1).
get_list([X|_],N,X,N) :- !.
get_list([_|Xs],N,X,N1) :-
N2 is N1 + 1,
!,
get_list(Xs,N,X,N2).
%%% Get all distinct subterms of a term.
get_subterms(T,Ss) :-
get_subterms_1(T,Ss1),
identical_delete_all_duplicates(Ss1,Ss),
!.
get_subterms_1(T,[T]) :-
var(T),
!.
get_subterms_1(T,[T|Ss]) :-
functor(T,_,N),
get_subterms_2(T,N,Ss),
!.
get_subterms_2(_,0,[]).
get_subterms_2(T,N,Ss) :-
arg(N,T,T1),
get_subterms_1(T1,Ss1),
N1 is N-1,
get_subterms_2(T,N1,Ss2),
append(Ss2,Ss1,Ss),
!.
%%% Gensym -- from Clocksin and Mellish
gensym(Root,Atom) :-
get_num(Root,Num),
name(Root,Name1),
name(Num,Name2),
append(Name1,Name2,Name),
name(Atom,Name).
get_num(Root,Num) :-
retract(current_num(Root,Num1)),
!,
Num is Num1+1,
asserta(current_num(Root,Num)).
get_num(Root,1) :-
asserta(current_num(Root,1)).
%%% Common_variables determines the variables common to two terms.
common_variables(T1,T2,Vs) :-
list_vars(T1,Vs1),
list_vars(T2,Vs2),
common_variables_1(Vs1,Vs2,Vs).
common_variables_1([],_,[]).
common_variables_1([V|Vs1],Vs2,[V|Vs3]) :-
identical_member(V,Vs2),
!,
common_variables_1(Vs1,Vs2,Vs3).
common_variables_1([_|Vs1],Vs2,Vs3) :-
!,
common_variables_1(Vs1,Vs2,Vs3).
%%% Determine if one term S is a subterm of another term T.
is_subterm(S,T) :-
S==T,
!.
is_subterm(S,T) :-
nonvar(T),
!,
functor(T,_,N),
is_subterm_1(S,T,N).
is_subterm_1(_,_,0) :-
!,
fail.
is_subterm_1(S,T,N) :-
arg(N,T,T1),
is_subterm(S,T1),
!.
is_subterm_1(S,T,N) :-
N1 is N-1,
!,
is_subterm_1(S,T,N1).
%%% Determine if the first set is a subset of the second set.
identical_subset([],_).
identical_subset([A|X],Y) :-
identical_member(A,Y),
identical_subset(X,Y).
%%% Compute set difference.
identical_set_difference([],_,[]).
identical_set_difference([A|X],Y,Z) :-
identical_member(A,Y),
!,
identical_set_difference(X,Y,Z).
identical_set_difference([A|X],Y,[A|Z]) :-
identical_set_difference(X,Y,Z).
%%% substitute_term(T,U,V,Ts) :-
%%% input
%%% T : term
%%% U : term
%%% V : term not identical to U
%%% output
%%% Ts : list of terms T' such T' is T with a single occurrence of U
%%% replaced by V. Note that the length of Ts is equal to the number
%%% of occurrences of U in T.
substitute_term(T,U,V,Ts) :-
bagof1(T1,substitute_term_1(T,U,V,T1),Ts).
substitute_term_1(T1,U,V,T2) :-
substitute_term_2(T1,U,V,T2),
T1\==T2.
substitute_term_2(T,U,V,V) :-
T==U.
substitute_term_2(T,_,_,T) :-
var(T).
substitute_term_2(T1,U,V,T2) :-
nonvar(T1),
T1=..[F|Ts1],
substitute_term_3(Ts1,U,V,Ts2),
T2=..[F|Ts2].
substitute_term_3([],_,_,[]).
substitute_term_3([T1|Ts1],U,V,[T2|Ts2]) :-
substitute_term_2(T1,U,V,T2),
substitute_term_4(T1,T2,Ts1,U,V,Ts2).
substitute_term_4(T1,T2,Ts,_,_,Ts) :-
T1\==T2.
substitute_term_4(T1,T2,Ts1,U,V,Ts2) :-
T1==T2,
substitute_term_3(Ts1,U,V,Ts2).
%%% substitute_term_all(T1,U,V,T2) :-
%%% input
%%% T1 : term
%%% U : term
%%% V : term not identical to U
%%% output
%%% T2 : T with a all occurrences of U replaced by V.
substitute_term_all(T,U,V,V) :-
T==U,
!.
substitute_term_all(T,_,_,T) :-
var(T),
!.
substitute_term_all(T1,U,V,T2) :-
T1=..[F|Ts1],
substitute_term_all_1(Ts1,U,V,Ts2),
T2=..[F|Ts2].
substitute_term_all_1([],_,_,[]).
substitute_term_all_1([T1|Ts1],U,V,[T2|Ts2]) :-
substitute_term_all(T1,U,V,T2),
substitute_term_all_1(Ts1,U,V,Ts2).
%%% identical_embedded(U,V)
%%% input
%%% U : term
%%% V : term
%%% exception
%%% fails if U not embedded in V
identical_embedded(U,V) :-
U==V,
!.
identical_embedded(U,V) :-
var(V),
!,
fail.
identical_embedded(U,V) :-
nonvar(U),
functor(U,F,N),
functor(V,F,N),
U=..[_|Us],
V=..[_|Vs],
identical_embedded_1(Us,Vs).
identical_embedded(U,V) :-
V=..[_|Vs],
identical_embedded_2(U,Vs).
identical_embedded_1([],[]) :- !.
identical_embedded_1([U|Us],[V|Vs]) :-
identical_embedded(U,V),
identical_embedded_1(Us,Vs).
identical_embedded_2(U,[V|_]) :-
identical_embedded(U,V),
!.
identical_embedded_2(U,[_|Vs]) :-
identical_embedded_2(U,Vs).
%%% identical_set(S1,S2)
%%% input
%%% S1 : set
%%% S2 : set
%%% exceptions
%%% fails if S1 does not equal S2
identical_set(S1,S2) :-
length(S1,N),
length(S2,N),
identical_subset(S1,S2).
%%% replace_list(L1,N,T,L2)
%%% input
%%% L1 : list
%%% N : integer
%%% T : term
%%% output
%%% L2 : L1 with Nth element replaced with T
%%% exceptions
%%% fails if N<0 or N>|L|
replace_list(L1,N,T,L2) :- replace_list_1(L1,N,T,L2,1).
replace_list_1([_|L1],N,T,[T|L1],N) :- !.
replace_list_1([T1|L1],N,T2,[T1|L2],N1) :-
N2 is N1 + 1,
replace_list_1(L1,N,T2,L2,N2).
%%%
%%% or_list(L,V)
%%% input
%%% L : list of 0s and 1s
%%% output
%%% V : or the elements of L where 0 is false and 1 is true
%%%
or_list(L,1) :-
member(1,L),
!.
or_list(_,0).
%%%
%%% permutations(L,P)
%%% input
%%% L : list
%%% output
%%% P : list of permutations of L
%%%
permutations([],[[]]) :- !.
permutations([X],[[X]]) :- !.
permutations([X,Y],[[X,Y],[Y,X]]) :- !.
permutations(L,P) :-
bagof(Pi,permutations_1(L,Pi),Pis),
append_lists(Pis,P).
permutations_1(L,Pi) :-
member_N(L,X,L1),
permutations(L1,Pi1),
permutations_2(Pi1,X,Pi).
permutations_2([],_,[]) :- !.
permutations_2([L|Pi1],X,[[X|L]|Pi2]) :-
permutations_2(Pi1,X,Pi2).
%%%
%%% append_lists(Ls,L)
%%% input
%%% Ls : list of lists
%%% output
%%% L : lists of Ls appended together
%%%
append_lists([],[]) :- !.
append_lists([L1|Ls],L2) :-
append_lists(Ls,L3),
append(L1,L3,L2).
%%%
%%% tail(L,X)
%%% input
%%% L : list
%%% output
%%% X : last element in L
%%% exceptions
%%% fails if L is empty
%%%
tail([X],X) :- !.
tail([_|L],X) :-
tail(L,X).
%%%
%%% retract_all(X)
%%% input
%%% X : Prolog term
%%%
retract_all(X) :-
retract(X),
fail.
retract_all(_).
%%%
%%% term_size_structure(Term,Size_structure)
%%% input
%%% Term : Prolog term
%%% output
%%% Structure: term structured like Term containing subterm sizes. For
%%% example, term_size_structure(f(f(X,g(a)),a),Structure) sets
%%% structure to ss(6,ss(4,ss(1),ss(2,ss(1))),ss(1)).
%%%
term_size_structure(Term,ss(1)) :-
var(Term),
!.
term_size_structure(Term,Size_structure) :-
functor(Term,_,N),
term_size_structure_1(N,Term,0,Size1,Size_structure_list),
Size is Size1+1,
Size_structure =.. [ss,Size|Size_structure_list].
term_size_structure_1(0,_,Size,Size,[]) :- !.
term_size_structure_1(N,Term,Size1,Size2,
[Size_structure|Size_structure_list]) :-
functor(Term,_,M),
I is M-N+1,
arg(I,Term,Arg),
term_size_structure(Arg,Size_structure),
arg(1,Size_structure,Size3),
Size4 is Size1+Size3,
N1 is N-1,
term_size_structure_1(N1,Term,Size4,Size2,Size_structure_list).
%%%
%%% enumerate(M,N,S,I)
%%% input
%%% M : integer
%%% N : integer
%%% S : non-zero integer
%%% output
%%% I : integer
%%% note:
%%% returns integers M through N inclusive by S via backtraking
%%%
enumerate(M,N,S,_) :-
((S>0, M>N);(S<0,M<N)),
!,
fail.
enumerate(M,N,_,M).
enumerate(M,N,S,I) :-
M1 is M+S,
enumerate(M1,N,S,I).